例えば友人との交流や会社での人間関係、あるいは企業間の取引関係など、要素同士が何らかの関係で結びついた網の目のような構造をネットワークと呼びます。
このネットワークの構造や特徴を探るのがネットワーク分析です。
ネットワークの一例を示します。
これはアメリカの大学の空手クラブの人間関係を表したネットワークです。IrisやTaitanicのデータと同じように、ネットワーク分析のデモデータとしてよく使われるデータです。
library(conflicted)
library(tidyverse)
library(igraph)
library(tidygraph)
library(ggraph)
library(patchwork)
library(visNetwork)
library(igraphdata) # デモデータの用意
data("karate")
karate <- karate |>
as_tbl_graph(directed = FALSE)
set.seed(1)
karate |>
ggraph(layout = "fr") +
geom_edge_link(
aes(edge_width = weight),
color = "gray50",
alpha = 0.5
) +
scale_edge_width(range = c(0.5, 3)) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 7) +
geom_node_text(aes(label = label), color = "navy") +
labs(title = "ネットワーク図") +
theme_graph() +
theme(aspect.ratio = 3/4)ネットワークの分かりやすい例としてSNSのフォロー関係があります。
このネットワークを構成する円を「ノード」と呼びます。「頂点」とか「ヴァーテックス」と呼ばれることもあります。SNSで言えば個々のアカウントになります。
ノードとノードを結ぶ線を「エッジ」と呼びます。「辺」とか「リンク」と呼ばれることもあります。SNSで言えばフォロー関係などになります。エッジは方向性を持つ場合もあります。エッジが方向性を持つ場合のネットワークは「有向グラフ」、方向性を持たない場合は「無向グラフ」と呼ばれます。
ネットワークのデータはこの「ノード」と「エッジ」の2つの情報から構成されます。
Rでネットワーク分析を行う場合、よく使われるのは以下のパッケージです。
まず、ネットワークのデータをRでどのように取り扱うか見てみましょう。
このようなシンプルなネットワークを考えます。
matrix(
c(
0,0,0,0,
1,0,0,0,
1,1,0,0,
1,1,1,0
), nrow = 4, byrow = TRUE,
dimnames = list(c("A", "B", "C", "D"),c("A", "B", "C", "D"))
) |>
as_tbl_graph() |>
ggraph(layout = "fr") +
geom_edge_fan(color = "gray50", alpha = 0.5) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 7) +
geom_node_text(aes(label = name), color = "navy") +
labs(title = "シンプルなネットワーク") +
theme_graph() +
theme(aspect.ratio = 3/4)このネットワークをデータとして扱うには「隣接行列」と「エッジリスト」の2つの方法があります。
隣接行列はマトリクス形式でノード間のエッジの存在と重みを表現します。
edges_matrix <- matrix(
c(
0,0,0,0,
1,0,0,0,
1,1,0,0,
1,1,1,0
), nrow = 4, byrow = TRUE,
dimnames = list(c("A", "B", "C", "D"),c("A", "B", "C", "D"))
)
edges_matrix## A B C D
## A 0 0 0 0
## B 1 0 0 0
## C 1 1 0 0
## D 1 1 1 0
エッジリストはデータフレーム形式でform列とto列を持ち、各行にどのノードとどのノードにエッジが存在するかを表します。
edges_list <- data.frame(
from = c("B", "C", "C", "D", "D", "D"),
to = c("A", "A", "B", "A", "B", "C")
)
edges_list## from to
## 1 B A
## 2 C A
## 3 C B
## 4 D A
## 5 D B
## 6 D C
どちらも場合もtidygraphパッケージのas_tbl_graph()関数を通してネットワークのオブジェクトに変換します。
## # A tbl_graph: 4 nodes and 6 edges
## #
## # A directed acyclic simple graph with 1 component
## #
## # Node Data: 4 × 1 (active)
## name
## <chr>
## 1 A
## 2 B
## 3 C
## 4 D
## #
## # Edge Data: 6 × 3
## from to weight
## <int> <int> <dbl>
## 1 2 1 1
## 2 3 1 1
## 3 3 2 1
## # ℹ 3 more rows
## # A tbl_graph: 4 nodes and 6 edges
## #
## # A directed acyclic simple graph with 1 component
## #
## # Node Data: 4 × 1 (active)
## name
## <chr>
## 1 B
## 2 C
## 3 D
## 4 A
## #
## # Edge Data: 6 × 2
## from to
## <int> <int>
## 1 1 4
## 2 2 4
## 3 2 1
## # ℹ 3 more rows
エッジリストにはweight列がありませんが、これはエッジリストに追加すれば同じになります。
## # A tbl_graph: 4 nodes and 6 edges
## #
## # A directed acyclic simple graph with 1 component
## #
## # Node Data: 4 × 1 (active)
## name
## <chr>
## 1 B
## 2 C
## 3 D
## 4 A
## #
## # Edge Data: 6 × 3
## from to weight
## <int> <int> <dbl>
## 1 1 4 1
## 2 2 4 1
## 3 2 1 1
## # ℹ 3 more rows
元のデータの表現は違いますが全く同じネットワークです。
set.seed(1)
p1 <- g1 |>
as_tbl_graph() |>
ggraph(layout = "fr") +
geom_edge_fan(color = "gray50", alpha = 0.5) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 7) +
geom_node_text(aes(label = name), color = "navy") +
labs(title = "隣接行列") +
theme_graph() +
theme(aspect.ratio = 3/4)
set.seed(1)
p2 <- g2 |>
as_tbl_graph() |>
ggraph(layout = "fr") +
geom_edge_fan(color = "gray50", alpha = 0.5) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 7) +
geom_node_text(aes(label = name), color = "navy") +
labs(title = "エッジリスト") +
theme_graph() +
theme(aspect.ratio = 3/4)
p1 + p2ネットワーク図の描画によく使われるのは以下の3つの方法です
最もシンプルに描画できるのがigraphパッケージのplot()関数です。工夫すればキレイな描画も可能です。
ggraphはggplot2ベースなのでggplot2に慣れている人には理解しやすいです。
karate |>
ggraph(layout = "fr") +
geom_edge_link(color = "gray50", alpha = 0.5) +
geom_node_point(aes(fill = as.factor(color)), shape = 21, color = "black", size = 7) +
geom_node_text(aes(label = label), color = "navy") +
labs(title = "ggraph") +
theme_graph() +
theme(aspect.ratio = 3/4, legend.position = "none")visNetworkパッケージを使うと動的なネットワーク図が描けます。
こちらは動的なネットワーク図を作れます。
ぐりぐり動かしてみましょう。
ここではggraphパッケージの使い方をもう少し詳しく紹介します。
ggraphパッケージはggplot2ベースでgeom_edge_*でエッジをgeom_node_*でノードを描くのが基本形になります。
これだとイマイチですね。ノードを大きくして色を付けてみましょう。ノードの設定はgeom_node_point()の引数でコントロールできます。
karate |>
ggraph() +
geom_edge_link() +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 10)エッジの色をグレーにしてみます。重なりが分かるように透明度も追加します。geom_edge_link()関数でコントロールできます。
karate |>
ggraph() +
geom_edge_link(color = "gray", alpha = 0.5) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 10)エッジの重みをエッジの太さに反映させてみます。ノードごとに値が変わる変数を指定する場合はggplot2同様にaes()関数で囲みます。
karate |>
ggraph() +
geom_edge_link(aes(width = weight), color = "gray", alpha = 0.5) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 10)ノードにラベルを貼ってみましょう。geom_node_text()を追加します。
karate |>
ggraph() +
geom_edge_link(aes(width = weight), color = "gray") +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 10) +
geom_node_text(aes(label = label), color = "navy")最後の調整です。エッジの太さの範囲を指定して、背景を白にして、タイトルを付けます。
karate |>
ggraph() +
geom_edge_link(aes(width = weight), color = "gray", alpha = 0.5) +
scale_edge_width(range = c(0.5, 3)) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 10) +
geom_node_text(aes(label = label), color = "navy") +
labs(title = "ggraphによるネットワーク図") +
theme_graph()どうでしょうか。割といい感じでしょ?
ggraphでは様々なレイアウト(ノードの配置)を指定できます。
例えば円形に並べるとこうなります。
set.seed(1)
karate |>
ggraph(layout = "circle") +
geom_edge_link(
aes(edge_width = weight),
color = "gray50",
alpha = 0.5
) +
scale_edge_width(range = c(0.5, 3)) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 7) +
geom_node_text(aes(label = label), color = "navy") +
labs(title = 'layout = "circle"') +
theme_graph() +
theme(aspect.ratio = 1, legend.position = "none")レイアウト例を並べてみます。
my_ggraph_layouts <- function(layout) {
set.seed(2)
karate |>
ggraph(layout = layout) +
geom_edge_link(aes(width = weight), color = "gray") +
scale_edge_width(range = c(0.5, 2)) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 5) +
labs(title = layout) +
theme_graph() +
theme(legend.position = "none", aspect.ratio = 1)
}
layouts <- c("sugiyama", "tree", "star", "circle", "dh",
"gem", "graphopt", "grid", "mds", "sphere",
"fr", "kk", "drl", "lgl")
layouts_plot <- map(layouts, \(x) my_ggraph_layouts(x))
{layouts_plot[[1]] | layouts_plot[[2]]} /
{layouts_plot[[3]] | layouts_plot[[4]]} /
{layouts_plot[[5]] | layouts_plot[[6]]} /
{layouts_plot[[7]] | layouts_plot[[8]]} /
{layouts_plot[[9]] | layouts_plot[[10]]} /
{layouts_plot[[11]] | layouts_plot[[12]]} /
{layouts_plot[[13]] | layouts_plot[[14]]}エッジの表現もいろいろ選べます。
g3 <- matrix(
c(0,1,1,1, 1,0,0,0, 1,1,0,0, 1,1,1,0), nrow = 4, byrow = TRUE,
dimnames = list(c("A", "B", "C", "D"),c("A", "B", "C", "D"))
) |>
as_tbl_graph()
set.seed(2)
p1 <- g3 |>
ggraph("fr") +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_edge_link(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_link") +
theme_graph()
set.seed(2)
p2 <- g3 |>
ggraph("fr") +
geom_edge_arc(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_arc") +
theme_graph()
set.seed(2)
p3 <- g3 |>
ggraph("fr") +
geom_edge_bend(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_bend") +
theme_graph()
set.seed(2)
p4 <- g3 |>
ggraph("fr") +
geom_edge_hive(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_hive") +
theme_graph()
# 複線対応
set.seed(2)
p5 <- g3 |>
ggraph("fr") +
geom_edge_fan(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_fan") +
theme_graph()
set.seed(2)
p6 <- g3 |>
ggraph("fr") +
geom_edge_parallel(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_parallel") +
theme_graph()
# 自己ループ追加
set.seed(2)
p7 <- data.frame(
from = c("A", "A", "A", "B", "C", "C", "D", "D", "D", "B", "C", "D"),
to = c("B", "C", "D", "A", "A", "B", "A", "B", "C", "B", "C", "D")
) |>
as_tbl_graph() |>
ggraph("fr") +
geom_edge_fan(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_edge_loop(arrow = arrow(),
end_cap = circle(3, "mm"),
start_cap = circle(3, "mm")) +
geom_node_point(size=6, shape = 21, color = "black", fill = "orange") +
geom_node_text(aes(label = name)) +
labs(title = "geom_edge_loop") +
theme_graph()
{p1 | p2 } /
{p3 | p4 } /
{p5 | p6} /
{p7 | plot_spacer()}さて、そろそろ分析っぽいことをしましょうか。
ネットワーク構造から各ノードがどれくらい中心的な役割を果たしているのかを定量化するのが「中心性指標」です。
SNSで言えばフォロワーが多いほど重要人物っぽいと考えられますよね。そのような考え方です。
中心性指標にはいくつかの手法が提案されています。ここでは代表的なものを3つ挙げます。
実際に計算してみましょう。
ネットワークのオブジェクト(tbl_graphクラス)にはノードとエッジの2つの情報が格納されているので、まずactivate()関数でノードの方を指定してから、通常のデータフレームと同じようにmutate()で各ノードの中心性指標を追加します。
gc <- g3 |>
activate(nodes) |>
mutate(
cd_in = centrality_degree(weights = weight, mode = "in"),
cd_out = centrality_degree(weights = weight, mode = "out"),
cd_all = centrality_degree(weights = weight, mode = "all"),
between = centrality_betweenness(weights = weight),
pagerank = centrality_pagerank(weights = weight)
)
# 描画
set.seed(1)
p1 <- gc |>
ggraph("fr", weights = weight) +
geom_edge_fan(
aes(width = weight),
color = "gray40", alpha = 0.5,arrow = arrow(), end_cap = circle(6, "mm"), start_cap = circle(6, "mm")) +
scale_edge_width(range = c(1,5)) +
geom_node_point(aes(size=cd_in), shape = 21, color = "black", fill = "orange") +
scale_size(range = c(3,12)) +
geom_node_text(aes(label = cd_in)) +
labs(title = "次数中心性(in)") +
theme_graph() +
theme(legend.position = "none", aspect.ratio = 1)
set.seed(1)
p2 <- gc |>
ggraph("fr", weights = weight) +
geom_edge_fan(
aes(width = weight),
color = "gray40", alpha = 0.5,arrow = arrow(), end_cap = circle(6, "mm"), start_cap = circle(6, "mm")) +
scale_edge_width(range = c(1,5)) +
geom_node_point(aes(size=cd_out), shape = 21, color = "black", fill = "orange") +
scale_size(range = c(3,15)) +
geom_node_text(aes(label = cd_out)) +
labs(title = "次数中心性(out)") +
theme_graph() +
theme(legend.position = "none", aspect.ratio = 1)
set.seed(1)
p3 <- gc |>
ggraph("fr", weights = weight) +
geom_edge_fan(
aes(width = weight),
color = "gray40", alpha = 0.5,arrow = arrow(), end_cap = circle(6, "mm"), start_cap = circle(6, "mm")) +
scale_edge_width(range = c(1,5)) +
geom_node_point(aes(size=cd_all), shape = 21, color = "black", fill = "orange") +
scale_size(range = c(3,15)) +
geom_node_text(aes(label = cd_all)) +
labs(title = "次数中心性(all)") +
theme_graph() +
theme(legend.position = "none", aspect.ratio = 1)
set.seed(1)
p4 <- gc |>
ggraph("fr", weights = weight) +
geom_edge_fan(
aes(width = weight),
color = "gray40", alpha = 0.5,arrow = arrow(), end_cap = circle(6, "mm"), start_cap = circle(6, "mm")) +
scale_edge_width(range = c(1,5)) +
geom_node_point(aes(size=between), shape = 21, color = "black", fill = "orange") +
scale_size(range = c(3,15)) +
geom_node_text(aes(label = between)) +
labs(title = "媒介中心性") +
theme_graph() +
theme(legend.position = "none", aspect.ratio = 1)
set.seed(1)
p5 <- gc |>
ggraph("fr", weights = weight) +
geom_edge_fan(
aes(width = weight),
color = "gray40", alpha = 0.5,arrow = arrow(), end_cap = circle(6, "mm"), start_cap = circle(6, "mm")) +
scale_edge_width(range = c(1,5)) +
geom_node_point(aes(size=pagerank), shape = 21, color = "black", fill = "orange") +
scale_size(range = c(3,15)) +
geom_node_text(aes(label = round(pagerank,2))) +
labs(title = "ページランク") +
theme_graph() +
theme(legend.position = "none", aspect.ratio = 1)
p1 + p2 + p3 + p4 + p5 + plot_spacer() + plot_layout(ncol = 2)数値も確認しましょう。
こちらもactivate()でノードを指定してからデータフレームに変換すればOKです。
## # A tibble: 4 × 6
## name cd_in cd_out cd_all between pagerank
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 A 3 3 6 3 0.391
## 2 B 3 1 4 0 0.271
## 3 C 2 2 4 0 0.190
## 4 D 1 3 4 0 0.148
次にコミュニティ抽出を行います。これはクラスター分析のネットワーク版です。
まずは分かりやすいネットワークで試してみましょう。
明らかに4つのグループが存在します。
islands <- play_islands(
n_islands = 4,
size_islands = 15,
p_within = 0.7,
m_between = 3
)
islands |>
ggraph(layout = "fr") +
geom_edge_fan(color = "gray", alpha = 0.7) +
geom_node_point(shape = 21, color = "black", fill = "orange", size = 6) +
theme_graph()このグラフをコミュニティ抽出します。
これもいくつかの手法が提案されており、今回は以下の4つの手法を試してみます。
islands_clust <- islands |>
activate(nodes) |>
mutate(
fast_greedy = as.factor(group_fast_greedy()),
louvain = as.factor(group_louvain()),
infomap = as.factor(group_infomap()),
edge_betweenness = as.factor(group_edge_betweenness())
)ネットワーク図で確認しましょう。どの手法でも適切にグループ分けできているようです。
set.seed(1)
p1 <- islands_clust |>
ggraph("fr") +
geom_edge_link(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = fast_greedy), size = 6, shape = 21, color = "black") +
labs(title = "Greedy optimization of modularity") +
theme_graph() +
theme(legend.position = "none")
set.seed(1)
p2 <- islands_clust |>
ggraph("fr") +
geom_edge_fan(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = louvain), size = 6, shape = 21, color = "black") +
labs(title = "The Louvain algorithm") +
theme_graph() +
theme(legend.position = "none")
set.seed(1)
p3 <- islands_clust |>
ggraph("fr") +
geom_edge_fan(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = infomap), size = 6, shape = 21, color = "black") +
labs(title = "The Infomap algorithm") +
theme_graph() +
theme(legend.position = "none")
set.seed(1)
p4 <- islands_clust |>
ggraph("fr") +
geom_edge_fan(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = edge_betweenness), size = 6, shape = 21, color = "black") +
labs(title = "Community structure detection\n based on edge betweenness") +
theme_graph() +
theme(legend.position = "none")
{p1|p2}/{p3|p4}なお、最適化貪欲アルゴリズムとエッジの媒介中心性に基づくコミュニティ抽出は階層型の手法なので、デンドログラムを描くこともできます。
空手クラブのデータでも試してみましょう。
karate_clust <- karate |>
activate(nodes) |>
mutate(
fast_greedy = as.factor(group_fast_greedy()),
louvain = as.factor(group_louvain()),
infomap = as.factor(group_infomap()),
edge_betweenness = as.factor(group_edge_betweenness())
)
set.seed(1)
p1 <- karate_clust |>
ggraph("fr") +
geom_edge_link(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = fast_greedy), size = 6, shape = 21, color = "black") +
labs(title = "Greedy optimization of modularity") +
theme_graph()
set.seed(1)
p2 <- karate_clust |>
ggraph("fr") +
geom_edge_fan(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = louvain), size = 6, shape = 21, color = "black") +
labs(title = "The Louvain algorithm") +
theme_graph()
set.seed(1)
p3 <- karate_clust |>
ggraph("fr") +
geom_edge_fan(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = infomap), size = 6, shape = 21, color = "black") +
labs(title = "The Infomap algorithm") +
theme_graph()
set.seed(1)
p4 <- karate_clust |>
ggraph("fr") +
geom_edge_fan(color = "gray40", alpha = 0.5) +
geom_node_point(aes(fill = edge_betweenness), size = 6, shape = 21, color = "black") +
labs(title = "Community structure detection\n based on edge betweenness") +
theme_graph()
{p1|p2}/{p3|p4}Handbook of Graphs and Networks in People Analytics With Examples in R and Python
実践で学ぶネットワーク分析(Tokyo.R#32, 2013)
{tidygraph}と{ggraph}による モダンなネットワーク分析(Tokyo.R #69, 2018)
以上。